home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / f2c / may_5_92.lha / f2c.VMay_5_1992 / src / gram.dcl < prev    next >
Text File  |  1992-05-07  |  8KB  |  400 lines
  1. spec:      dcl
  2.     | common
  3.     | external
  4.     | intrinsic
  5.     | equivalence
  6.     | data
  7.     | implicit
  8.     | namelist
  9.     | SSAVE
  10.         { NO66("SAVE statement");
  11.           saveall = YES; }
  12.     | SSAVE savelist
  13.         { NO66("SAVE statement"); }
  14.     | SFORMAT
  15.         { fmtstmt(thislabel); setfmt(thislabel); }
  16.     | SPARAM in_dcl SLPAR paramlist SRPAR
  17.         { NO66("PARAMETER statement"); }
  18.     ;
  19.  
  20. dcl:      type opt_comma name in_dcl new_dcl dims lengspec
  21.         { settype($3, $1, $7);
  22.           if(ndim>0) setbound($3,ndim,dims);
  23.         }
  24.     | dcl SCOMMA name dims lengspec
  25.         { settype($3, $1, $5);
  26.           if(ndim>0) setbound($3,ndim,dims);
  27.         }
  28.     | dcl SSLASHD datainit vallist SSLASHD
  29.         { if (new_dcl == 2) {
  30.             err("attempt to give DATA in type-declaration");
  31.             new_dcl = 1;
  32.             }
  33.         }
  34.     ;
  35.  
  36. new_dcl:    { new_dcl = 2; }
  37.  
  38. type:      typespec lengspec
  39.         { varleng = $2;
  40.           if (vartype == TYLOGICAL && varleng == 1) {
  41.             varleng = 0;
  42.             err("treating LOGICAL*1 as LOGICAL");
  43.             --nerr;    /* allow generation of .c file */
  44.             }
  45.         }
  46.     ;
  47.  
  48. typespec:  typename
  49.         { varleng = ($1<0 || $1==TYLONG ? 0 : typesize[$1]);
  50.           vartype = $1; }
  51.     ;
  52.  
  53. typename:    SINTEGER    { $$ = TYLONG; }
  54.     | SREAL        { $$ = tyreal; }
  55.     | SCOMPLEX    { ++complex_seen; $$ = tycomplex; }
  56.     | SDOUBLE    { $$ = TYDREAL; }
  57.     | SDCOMPLEX    { ++dcomplex_seen; NOEXT("DOUBLE COMPLEX statement"); $$ = TYDCOMPLEX; }
  58.     | SLOGICAL    { $$ = TYLOGICAL; }
  59.     | SCHARACTER    { NO66("CHARACTER statement"); $$ = TYCHAR; }
  60.     | SUNDEFINED    { $$ = TYUNKNOWN; }
  61.     | SDIMENSION    { $$ = TYUNKNOWN; }
  62.     | SAUTOMATIC    { NOEXT("AUTOMATIC statement"); $$ = - STGAUTO; }
  63.     | SSTATIC    { NOEXT("STATIC statement"); $$ = - STGBSS; }
  64.     ;
  65.  
  66. lengspec:
  67.         { $$ = varleng; }
  68.     | SSTAR intonlyon expr intonlyoff
  69.         {
  70.         expptr p;
  71.         p = $3;
  72.         NO66("length specification *n");
  73.         if( ! ISICON(p) || p->constblock.Const.ci <= 0 )
  74.             {
  75.             $$ = 0;
  76.             dclerr("length must be a positive integer constant",
  77.                 NPNULL);
  78.             }
  79.         else {
  80.             if (vartype == TYCHAR)
  81.                 $$ = p->constblock.Const.ci;
  82.             else switch((int)p->constblock.Const.ci) {
  83.                 case 1:    $$ = 1; break;
  84.                 case 2: $$ = typesize[TYSHORT];    break;
  85.                 case 4: $$ = typesize[TYLONG];    break;
  86.                 case 8: $$ = typesize[TYDREAL];    break;
  87.                 case 16: $$ = typesize[TYDCOMPLEX]; break;
  88.                 default:
  89.                     dclerr("invalid length",NPNULL);
  90.                     $$ = varleng;
  91.                 }
  92.             }
  93.         }
  94.     | SSTAR intonlyon SLPAR SSTAR SRPAR intonlyoff
  95.         { NO66("length specification *(*)"); $$ = -1; }
  96.     ;
  97.  
  98. common:      SCOMMON in_dcl var
  99.         { incomm( $$ = comblock("") , $3 ); }
  100.     | SCOMMON in_dcl comblock var
  101.         { $$ = $3;  incomm($3, $4); }
  102.     | common opt_comma comblock opt_comma var
  103.         { $$ = $3;  incomm($3, $5); }
  104.     | common SCOMMA var
  105.         { incomm($1, $3); }
  106.     ;
  107.  
  108. comblock:  SCONCAT
  109.         { $$ = comblock(""); }
  110.     | SSLASH SNAME SSLASH
  111.         { $$ = comblock(token); }
  112.     ;
  113.  
  114. external: SEXTERNAL in_dcl name
  115.         { setext($3); }
  116.     | external SCOMMA name
  117.         { setext($3); }
  118.     ;
  119.  
  120. intrinsic:  SINTRINSIC in_dcl name
  121.         { NO66("INTRINSIC statement"); setintr($3); }
  122.     | intrinsic SCOMMA name
  123.         { setintr($3); }
  124.     ;
  125.  
  126. equivalence:  SEQUIV in_dcl equivset
  127.     | equivalence SCOMMA equivset
  128.     ;
  129.  
  130. equivset:  SLPAR equivlist SRPAR
  131.         {
  132.         struct Equivblock *p;
  133.         if(nequiv >= maxequiv)
  134.             many("equivalences", 'q', maxequiv);
  135.         p  =  & eqvclass[nequiv++];
  136.         p->eqvinit = NO;
  137.         p->eqvbottom = 0;
  138.         p->eqvtop = 0;
  139.         p->equivs = $2;
  140.         }
  141.     ;
  142.  
  143. equivlist:  lhs
  144.         { $$=ALLOC(Eqvchain);
  145.           $$->eqvitem.eqvlhs = (struct Primblock *)$1;
  146.         }
  147.     | equivlist SCOMMA lhs
  148.         { $$=ALLOC(Eqvchain);
  149.           $$->eqvitem.eqvlhs = (struct Primblock *) $3;
  150.           $$->eqvnextp = $1;
  151.         }
  152.     ;
  153.  
  154. data:      SDATA in_data datalist
  155.     | data opt_comma datalist
  156.     ;
  157.  
  158. in_data:
  159.         { if(parstate == OUTSIDE)
  160.             {
  161.             newproc();
  162.             startproc(ESNULL, CLMAIN);
  163.             }
  164.           if(parstate < INDATA)
  165.             {
  166.             enddcl();
  167.             parstate = INDATA;
  168.             datagripe = 1;
  169.             }
  170.         }
  171.     ;
  172.  
  173. datalist:  datainit datavarlist SSLASH datapop vallist SSLASH
  174.         { ftnint junk;
  175.           if(nextdata(&junk) != NULL)
  176.             err("too few initializers");
  177.           frdata($2);
  178.           frrpl();
  179.         }
  180.     ;
  181.  
  182. datainit: /* nothing */ { frchain(&datastack); curdtp = 0; }
  183.  
  184. datapop: /* nothing */ { pop_datastack(); }
  185.  
  186. vallist:  { toomanyinit = NO; }  val
  187.     | vallist SCOMMA val
  188.     ;
  189.  
  190. val:      value
  191.         { dataval(ENULL, $1); }
  192.     | simple SSTAR value
  193.         { dataval($1, $3); }
  194.     ;
  195.  
  196. value:      simple
  197.     | addop simple
  198.         { if( $1==OPMINUS && ISCONST($2) )
  199.             consnegop((Constp)$2);
  200.           $$ = $2;
  201.         }
  202.     | complex_const
  203.     ;
  204.  
  205. savelist: saveitem
  206.     | savelist SCOMMA saveitem
  207.     ;
  208.  
  209. saveitem: name
  210.         { int k;
  211.           $1->vsave = YES;
  212.           k = $1->vstg;
  213.         if( ! ONEOF(k, M(STGUNKNOWN)|M(STGBSS)|M(STGINIT)) )
  214.             dclerr("can only save static variables", $1);
  215.         }
  216.     | comblock
  217.     ;
  218.  
  219. paramlist:  paramitem
  220.     | paramlist SCOMMA paramitem
  221.     ;
  222.  
  223. paramitem:  name SEQUALS expr
  224.         { if($1->vclass == CLUNKNOWN)
  225.             make_param((struct Paramblock *)$1, $3);
  226.           else dclerr("cannot make into parameter", $1);
  227.         }
  228.     ;
  229.  
  230. var:      name dims
  231.         { if(ndim>0) setbound($1, ndim, dims); }
  232.     ;
  233.  
  234. datavar:      lhs
  235.         { Namep np;
  236.           np = ( (struct Primblock *) $1) -> namep;
  237.           vardcl(np);
  238.           if(np->vstg == STGCOMMON)
  239.             extsymtab[np->vardesc.varno].extinit = YES;
  240.           else if(np->vstg==STGEQUIV)
  241.             eqvclass[np->vardesc.varno].eqvinit = YES;
  242.           else if(np->vstg!=STGINIT && np->vstg!=STGBSS)
  243.             dclerr("inconsistent storage classes", np);
  244.           $$ = mkchain((char *)$1, CHNULL);
  245.         }
  246.     | SLPAR datavarlist SCOMMA dospec SRPAR
  247.         { chainp p; struct Impldoblock *q;
  248.         pop_datastack();
  249.         q = ALLOC(Impldoblock);
  250.         q->tag = TIMPLDO;
  251.         (q->varnp = (Namep) ($4->datap))->vimpldovar = 1;
  252.         p = $4->nextp;
  253.         if(p)  { q->implb = (expptr)(p->datap); p = p->nextp; }
  254.         if(p)  { q->impub = (expptr)(p->datap); p = p->nextp; }
  255.         if(p)  { q->impstep = (expptr)(p->datap); }
  256.         frchain( & ($4) );
  257.         $$ = mkchain((char *)q, CHNULL);
  258.         q->datalist = hookup($2, $$);
  259.         }
  260.     ;
  261.  
  262. datavarlist: datavar
  263.         { if (!datastack)
  264.             curdtp = 0;
  265.           datastack = mkchain((char *)curdtp, datastack);
  266.           curdtp = $1; curdtelt = 0;
  267.           }
  268.     | datavarlist SCOMMA datavar
  269.         { $$ = hookup($1, $3); }
  270.     ;
  271.  
  272. dims:
  273.         { ndim = 0; }
  274.     | SLPAR dimlist SRPAR
  275.     ;
  276.  
  277. dimlist:   { ndim = 0; }   dim
  278.     | dimlist SCOMMA dim
  279.     ;
  280.  
  281. dim:      ubound
  282.         {
  283.           if(ndim == maxdim)
  284.             err("too many dimensions");
  285.           else if(ndim < maxdim)
  286.             { dims[ndim].lb = 0;
  287.               dims[ndim].ub = $1;
  288.             }
  289.           ++ndim;
  290.         }
  291.     | expr SCOLON ubound
  292.         {
  293.           if(ndim == maxdim)
  294.             err("too many dimensions");
  295.           else if(ndim < maxdim)
  296.             { dims[ndim].lb = $1;
  297.               dims[ndim].ub = $3;
  298.             }
  299.           ++ndim;
  300.         }
  301.     ;
  302.  
  303. ubound:      SSTAR
  304.         { $$ = 0; }
  305.     | expr
  306.     ;
  307.  
  308. labellist: label
  309.         { nstars = 1; labarray[0] = $1; }
  310.     | labellist SCOMMA label
  311.         { if(nstars < MAXLABLIST)  labarray[nstars++] = $3; }
  312.     ;
  313.  
  314. label:      SICON
  315.         { $$ = execlab( convci(toklen, token) ); }
  316.     ;
  317.  
  318. implicit:  SIMPLICIT in_dcl implist
  319.         { NO66("IMPLICIT statement"); }
  320.     | implicit SCOMMA implist
  321.     ;
  322.  
  323. implist:  imptype SLPAR letgroups SRPAR
  324.     | imptype
  325.         { if (vartype != TYUNKNOWN)
  326.             dclerr("-- expected letter range",NPNULL);
  327.           setimpl(vartype, varleng, 'a', 'z'); }
  328.     ;
  329.  
  330. imptype:   { needkwd = 1; } type
  331.         /* { vartype = $2; } */
  332.     ;
  333.  
  334. letgroups: letgroup
  335.     | letgroups SCOMMA letgroup
  336.     ;
  337.  
  338. letgroup:  letter
  339.         { setimpl(vartype, varleng, $1, $1); }
  340.     | letter SMINUS letter
  341.         { setimpl(vartype, varleng, $1, $3); }
  342.     ;
  343.  
  344. letter:  SNAME
  345.         { if(toklen!=1 || token[0]<'a' || token[0]>'z')
  346.             {
  347.             dclerr("implicit item must be single letter", NPNULL);
  348.             $$ = 0;
  349.             }
  350.           else $$ = token[0];
  351.         }
  352.     ;
  353.  
  354. namelist:    SNAMELIST
  355.     | namelist namelistentry
  356.     ;
  357.  
  358. namelistentry:  SSLASH name SSLASH namelistlist
  359.         {
  360.         if($2->vclass == CLUNKNOWN)
  361.             {
  362.             $2->vclass = CLNAMELIST;
  363.             $2->vtype = TYINT;
  364.             $2->vstg = STGBSS;
  365.             $2->varxptr.namelist = $4;
  366.             $2->vardesc.varno = ++lastvarno;
  367.             }
  368.         else dclerr("cannot be a namelist name", $2);
  369.         }
  370.     ;
  371.  
  372. namelistlist:  name
  373.         { $$ = mkchain((char *)$1, CHNULL); }
  374.     | namelistlist SCOMMA name
  375.         { $$ = hookup($1, mkchain((char *)$3, CHNULL)); }
  376.     ;
  377.  
  378. in_dcl:
  379.         { switch(parstate)
  380.             {
  381.             case OUTSIDE:    newproc();
  382.                     startproc(ESNULL, CLMAIN);
  383.             case INSIDE:    parstate = INDCL;
  384.             case INDCL:    break;
  385.  
  386.             case INDATA:
  387.                 if (datagripe) {
  388.                     errstr(
  389.                 "Statement order error: declaration after DATA",
  390.                         CNULL);
  391.                     datagripe = 0;
  392.                     }
  393.                 break;
  394.  
  395.             default:
  396.                 dclerr("declaration among executables", NPNULL);
  397.             }
  398.         }
  399.     ;
  400.